
#|
(defmacro p-extract-args (arglist)
  `(,@(loop for arg in arglist
	    unless (member arg '(&key &optional &rest &body &allow-other-keys))
	    collect (if (consp arg)
			(first arg)
			arg))))

(defmacro p-fold-args (arglist)
  `(append '(list) ,(p-extract-args arglist)))
|#

;; =============================================================================
;; p-fun/p-call macro definitions

(defvar *expander-function* (lambda (origin-name) (princ-to-string origin-name)))

(defmacro p-call (name &rest arglist)
  `(,(funcall *expander-function* name) ,@arglist))

(defmacro p-fun (name (&rest arglist) &rest body)
  (let ((func-result (gensym "func-result-"))
	(extract-argument-names (lambda (args)
				  (loop for arg in arglist
					unless (member arg '(&key &optional &rest &body &allow-other-keys))
					collect (if (consp arg)
						    (first arg)
						    arg)))))
    `(defun ,(funcall *expander-function* name) ,arglist
      ;; body
      (enter-scope ',name ,(append '(list) (funcall extract-argument-names arglist)))
      (let ((,func-result (progn ,@body)))
	(leave-scope ',name ,func-result)))))


;; =============================================================================
;; ri parser functions

;; parsing schema definition
(flet (
       ;; enter scope
       (enter-scope (name source-args)
	 (format t "entering scope <~a>: ~a~%" name source-args))
       
       ;; leave scope
       (leave-scope (name processed-args)
	 (format t "exiting scope <~a>:  ~a~%" name processed-args)
         ;; obligatory return of leave-scope
         processed-args)
       
       )
  ;; modify expander function
  (let ((*expander-function* (lambda (origin-name) (intern (concatenate 'string "parser-" (princ-to-string origin-name))))))

    ;; single arg
    (p-fun arg (type-spec arg-name)
	   (list type-spec arg-name))

    ;; let
    (p-fun let (type name init-expr)
	   (list type name init-expr))

    ;; set
    (p-fun set (var expr)
	   (list var expr))

    ;; call
    (p-fun call (func-name &rest args)
	   (list func-name args))

    ;; expressions block
    (p-fun block (block-expr)
	   (loop for expr in block-expr collect
                (progn
                  (destructuring-bind (expr-name &rest rest) expr
                    (cond
                      ;; let
                      ((eq 'let expr-name)
                       (destructuring-bind (type name &optional init-expr) rest
                         (p-call let type name init-expr)))

                      ;; call
                      ((eq 'call expr-name)
                       (destructuring-bind (func-name &rest arglist) rest
                         (p-call call func-name arglist)))

                      ;; set
                      ((eq 'set expr-name)
                       (destructuring-bind (var expr) rest
                         (p-call set var expr)))

                      ;; unknown expression
                      (t (error (format nil "unknown expression (~a ...) in block declaration" expr-name))))))))

    ;; struct-field
    (p-fun struct-field (type name)
           (list type name))

    ;; struct
    (p-fun struct (name fields)
           (list
            name
            (loop for f in fields collect
                 (destructuring-bind (type name) f
                   (p-call struct-field type name)))))

    ;; func
    (p-fun func (name args &rest body)
	   (list
	    ;; name left unchanged
	    name
	    ;; process each argument
	    (loop for arg-decl in args collect
		  (destructuring-bind (type-spec arg-name) arg-decl
		    (p-call arg type-spec arg-name)))
	    ;; body left unchanged (for a while)
	    body
	    ))
    ))

;; =============================================================================
;; test cases (TO BE DEFINED)

;; =============================================================================
;; test function
;; (parser-block '((let int a) (call main)))
;; (parser-block '((let int a) (call main) (call vortex 1 (+ 2 3))))



